home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 44 / PC Actual CD 44.iso / Linux / Cygwin / full.exe / Disk1 / data1.cab / Tools / share / tix4.1 / SListBox.tcl < prev    next >
Encoding:
Text File  |  1998-12-04  |  7.1 KB  |  305 lines
  1. # SListBox.tcl --
  2. #
  3. #    This file implements Scrolled Listbox widgets
  4. #
  5. # Copyright (c) 1996, Expert Interface Technologies
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10.  
  11.  
  12. # ToDo:
  13. # -anchor (none)
  14. #
  15.  
  16. tixWidgetClass tixScrolledListBox {
  17.     -classname TixScrolledListBox
  18.     -superclass tixScrolledWidget
  19.     -method {
  20.     }
  21.     -flag {
  22.     -anchor -browsecmd -command -state
  23.     }
  24.     -static {
  25.     -anchor
  26.     }
  27.     -configspec {
  28.     {-anchor anchor Anchor w}
  29.     {-browsecmd browseCmd BrowseCmd ""}
  30.     {-command command Command ""}
  31.     {-state state State normal}
  32.     {-takefocus takeFocus TakeFocus 1 tixVerifyBoolean}
  33.     }
  34.     -default {
  35.     {.scrollbar            auto}
  36.     {*borderWidth            1}
  37.     {*listbox.highlightBackground    #d9d9d9}
  38.     {*listbox.relief        sunken}
  39.     {*listbox.background        #c3c3c3}
  40.     {*listbox.takeFocus        1}
  41.     {*Scrollbar.background        #d9d9d9}
  42.     {*Scrollbar.troughColor        #c3c3c3}
  43.     {*Scrollbar.takeFocus        0}
  44.     {*Scrollbar.relief        sunken}
  45.     {*Scrollbar.width        15}
  46.     }
  47. }
  48.  
  49. proc tixScrolledListBox:InitWidgetRec {w} {
  50.     upvar #0 $w data
  51.  
  52.     tixChainMethod $w InitWidgetRec
  53.  
  54.     set data(x-first) 0
  55.     set data(x-last)  1
  56.     set data(y-first) 0
  57.     set data(y-last)  1
  58. }
  59.  
  60. proc tixScrolledListBox:ConstructWidget {w} {
  61.     upvar #0 $w data
  62.     global tcl_platform
  63.  
  64.     tixChainMethod $w ConstructWidget
  65.  
  66.     set data(w:listbox) \
  67.     [listbox $w.listbox]
  68.     set data(w:hsb) \
  69.     [scrollbar $w.hsb -orient horizontal]
  70.     set data(w:vsb) \
  71.     [scrollbar $w.vsb -orient vertical ]
  72.  
  73.     if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
  74.         set data(w:sizebox) [ide_sizebox $w.sizebox]
  75.     }
  76.  
  77.     set data(pw:client) $data(w:listbox)
  78. }
  79.  
  80. proc tixScrolledListBox:SetBindings {w} {
  81.     upvar #0 $w data
  82.  
  83.     tixChainMethod $w SetBindings
  84.  
  85.     $data(w:listbox) config \
  86.     -xscrollcommand "tixScrolledListBox:XView $w"\
  87.     -yscrollcommand "tixScrolledListBox:YView $w"
  88.  
  89.     $data(w:hsb) config -command "$data(w:listbox) xview"
  90.     $data(w:vsb) config -command "$data(w:listbox) yview"
  91.  
  92.     bind $w <Configure> "+tixScrolledListBox:Configure $w"
  93.     bind $w <FocusIn> "focus $data(w:listbox)"
  94.  
  95.     bindtags $data(w:listbox) \
  96.     "$data(w:listbox) TixListboxState Listbox TixListbox [winfo toplevel $data(w:listbox)] all"
  97.     tixSetMegaWidget $data(w:listbox) $w
  98. }
  99.  
  100. proc tixScrolledListBoxBind {} {
  101.     tixBind TixListboxState <1> {
  102.     if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
  103.         break
  104.     }
  105.     }
  106.     tixBind TixListbox      <1> {
  107.     if [tixGetBoolean -nocomplain [%W cget -takefocus]] {
  108.         focus %W
  109.     }
  110.     tixScrolledListBox:Browse [tixGetMegaWidget %W]
  111.     }
  112.  
  113.     tixBind TixListboxState <B1-Motion> {
  114.     if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
  115.         break
  116.     }
  117.     }
  118.     tixBind TixListbox      <B1-Motion> {
  119.     tixScrolledListBox:Browse [tixGetMegaWidget %W]
  120.     }
  121.  
  122.     tixBind TixListboxState <Up> {
  123.     if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
  124.         break
  125.     }
  126.     }
  127.     tixBind TixListbox      <Up> {
  128.     tixScrolledListBox:KeyBrowse [tixGetMegaWidget %W]
  129.     }
  130.  
  131.     tixBind TixListboxState <Down> {
  132.     if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
  133.         break
  134.     }
  135.     }
  136.     tixBind TixListbox      <Down> {
  137.     tixScrolledListBox:KeyBrowse [tixGetMegaWidget %W]
  138.     }
  139.  
  140.     tixBind TixListboxState <Return> {
  141.     if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
  142.         break
  143.     }
  144.     }
  145.     tixBind TixListbox      <Return> {
  146.     tixScrolledListBox:KeyInvoke [tixGetMegaWidget %W]
  147.     }
  148.  
  149.  
  150.     tixBind TixListboxState <Double-1> {
  151.     if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
  152.         break
  153.     }
  154.     }
  155.     tixBind TixListbox      <Double-1> {
  156.     tixScrolledListBox:Invoke [tixGetMegaWidget %W]
  157.     }
  158.  
  159.     tixBind TixListboxState <ButtonRelease-1> {
  160.     if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
  161.         break
  162.     }
  163.     }
  164.     tixBind TixListbox      <ButtonRelease-1> {
  165.     tixScrolledListBox:Browse [tixGetMegaWidget %W]
  166.     }
  167. }
  168.  
  169. proc tixScrolledListBox:Browse {w} {
  170.     upvar #0 $w data
  171.  
  172.     if {$data(-browsecmd) != ""} {
  173.     set bind(specs) {%V}
  174.     set bind(%V) [$data(w:listbox) get \
  175.         [$data(w:listbox) nearest [tixEvent flag y]]]
  176.     tixEvalCmdBinding $w $data(-browsecmd) bind
  177.     }
  178. }
  179.  
  180. proc tixScrolledListBox:KeyBrowse {w} {
  181.     upvar #0 $w data
  182.  
  183.     if {$data(-browsecmd) != ""} {
  184.     set bind(specs) {%V}
  185.     set bind(%V) [$data(w:listbox) get active]
  186.     tixEvalCmdBinding $w $data(-browsecmd) bind
  187.     }
  188. }
  189.  
  190. # tixScrolledListBox:Invoke --
  191. #
  192. #    The user has invoked the listbox by pressing either the <Returh>
  193. # key or double-clicking. Call the user-supplied -command function.
  194. #
  195. # For both -browsecmd and -command, it is the responsibility of the
  196. # user-supplied function to determine the current selection of the listbox
  197. # 
  198. proc tixScrolledListBox:Invoke {w} {
  199.     upvar #0 $w data
  200.  
  201.     if {$data(-command) != ""} {
  202.     set bind(specs) {%V}
  203.     set bind(%V) [$data(w:listbox) get \
  204.         [$data(w:listbox) nearest [tixEvent flag y]]]
  205.     tixEvalCmdBinding $w $data(-command) bind
  206.     }
  207. }
  208.  
  209. proc tixScrolledListBox:KeyInvoke {w} {
  210.     upvar #0 $w data
  211.  
  212.     if {$data(-command) != ""} {
  213.     set bind(specs) {%V}
  214.     set bind(%V) [$data(w:listbox) get active]
  215.     tixEvalCmdBinding $w $data(-command) bind
  216.     }
  217. }
  218.  
  219. #----------------------------------------------------------------------
  220. #
  221. #        option configs
  222. #----------------------------------------------------------------------
  223. proc tixScrolledListBox:config-takefocus {w value} {
  224.     upvar #0 $w data
  225.   
  226.     $data(w:listbox) config -takefocus $value
  227. }    
  228.  
  229.  
  230. #----------------------------------------------------------------------
  231. #
  232. #        Widget commands
  233. #----------------------------------------------------------------------
  234.  
  235.  
  236. #----------------------------------------------------------------------
  237. #
  238. #        Private Methods
  239. #----------------------------------------------------------------------
  240. proc tixScrolledListBox:XView {w first last} {
  241.     upvar #0 $w data
  242.  
  243.     set data(x-first) $first
  244.     set data(x-last) $last
  245.  
  246.     $data(w:hsb) set $first $last
  247.     tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
  248.  
  249.  
  250. }
  251.  
  252. proc tixScrolledListBox:YView {w first last} {
  253.     upvar #0 $w data
  254.  
  255.     set data(y-first) $first
  256.     set data(y-last) $last
  257.  
  258.     $data(w:vsb) set $first $last
  259.     tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
  260.  
  261.     # Somehow an update here must be used to advoid osscilation
  262.     #
  263.     update idletasks
  264. }
  265.  
  266. #
  267. #----------------------------------------------------------------------
  268. # virtual functions to query the client window's scroll requirement
  269. #----------------------------------------------------------------------
  270. proc tixScrolledListBox:GeometryInfo {w mW mH} {
  271.     upvar #0 $w data
  272.  
  273.     return [list \
  274.     [list $data(x-first) $data(x-last)]\
  275.     [list $data(y-first) $data(y-last)]]
  276. }
  277.  
  278. proc tixScrolledListBox:Configure {w} {
  279.     upvar #0 $w data
  280.  
  281.     tixWidgetDoWhenIdle tixScrolledListBox:TrickScrollbar $w
  282.  
  283.     if {$data(-anchor) == "e"} {
  284.     $data(w:listbox) xview 100000
  285.     }
  286. }
  287.  
  288. # This procedure is necessary because listbox does not call x,y scroll command
  289. # when its size is changed
  290. #
  291. proc tixScrolledListBox:TrickScrollbar {w} {
  292.     upvar #0 $w data
  293.  
  294.     if [$data(w:listbox) select include 0] {
  295.     set inc 1
  296.     } else {
  297.     set inc 0
  298.     }
  299.  
  300.     $data(w:listbox) select set 0
  301.     if {!$inc} {
  302.     $data(w:listbox) select clear 0
  303.     }
  304. }
  305.